home *** CD-ROM | disk | FTP | other *** search
/ Loadstar - Compleat Programmer / comprog1.d81 / b.modeling ii (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  3KB  |  102 lines
  1. 1 remsave"bridge.v3.3",8
  2. 2 goto400
  3. 56 rem==========any key-get a$=========
  4. 57 :
  5. 58 x=13:y=23:w$=" any key ":gosub66
  6. 59 :
  7. 60 rem============get a$===========
  8. 61 :
  9. 62 geta$:ifa$=""then 62:return
  10. 63 :
  11. 64 rem=======print at=============
  12. 65 :
  13. 66 poke783,peek(783)and254:poke782,x:poke781,y:sys65520:printw$
  14. 68 poke783,peek(783)or1:return
  15. 106 :
  16. 107 rem =====dim for deal======
  17. 109 :
  18. 111 nc=52:dims(nc),d$(14),va$(13),p(13),h(4,13)
  19. 112 fori=0to3:reads$(i):readco$(i):next
  20. 113 fori=0to12:readva$(i):readp(i):next
  21. 115 data"[216]","[144]","[218]","","[211]","","[193]","[144]",2,0,3,0,4,0,5,0,6,0,7,0,8,0,9,0,10,0
  22. 116 dataj,1,q,2,k,3,a,4
  23. 119 c$="[176][192][192][192][192][192][192][174][157][157][157][157][157][157][157][157][221]      [221][157][157][157][157][157][157][157][157][221]      [221][157][157][157][157][157][157][157][157][221]      [221]"
  24. 121 c$=c$+     "[157][157][157][157][157][157][157][157][221]      [221][157][157][157][157][157][157][157][157][221]      [221][157][157][157][157][157][157][157][157][221]      [221]"
  25. 123 c$=c$+"[157][157][157][157][157][157][157][157][173][192][192][192][192][192][192][189]"
  26. 124 :
  27. 125 rem========shuffle & deal======
  28. 126 :
  29. 127 forj=0tonc-1:s(j)=j:next:forj=0tonc-2:j%=j+int(rnd(0)*(nc-j)):
  30. 128 temp=s(j):s(j)=s(j%):s(j%)=temp:next
  31. 129 k=0:fori=1to4:forj=1to13:h(i,j)=s(k):k=k+1:next:next:return
  32. 130 :
  33. 131 rem ======suits,values,graphics===
  34. 132 :
  35. 133 fori=1to13:su=(int(h(r1,i)/13)):t=13*int(h(r1,i)/13)
  36. 134 de$=co$(su)+va$(h(r1,i)-t):hc=hc+p(h(r1,i)-t)
  37. 135 df$=de$+s$(su):d$(i)=c$+"[145][145][145][145][145][145][157][157][157][157][157][157][157]"+df$:next:return
  38. 179 :
  39. 180 rem========shell-metzner sort======
  40. 190 :
  41. 192 m=n
  42. 194 m=int(m/2):ifm=0then208
  43. 196 j=1:k=n-m
  44. 198 i=j
  45. 200 l=i+m
  46. 202 if h(r1,i)<h(r1,l)thent=h(r1,i):h(r1,i)=h(r1,l):h(r1,l)=t:i=i-m:ifi>0then200
  47. 204 j=j+1:ifj>k then194
  48. 206 goto198
  49. 207 next
  50. 208 return
  51. 397 :
  52. 398 rem========start of program=======
  53. 399 :
  54. 400 poke53280,1:poke53281,1:printchr$(8);chr$(142)
  55. 401 print"[147][144]           [193][193][193][193][193][193][193][193][193][193][193][193][193][193][193][193]"
  56. 402 print"           [211][211][211][211][211][211][211][211][211][211][211][211][211][211][211][211]"
  57. 403 print"[144]                bridge:    "
  58. 404 print "             a simulation  "
  59. 406 print"              of the deal   "
  60. 407 print"           [218][218][218][218][218][218][218][218][218][218][218][218][218][218][218][218]"
  61. 408 print"[144]           [216][216][216][216][216][216][216][216][216][216][216][216][216][216][216][216]"
  62. 409 :
  63. 410 gosub111:rem==set up and first deal
  64. 411 :
  65. 412 print"[147][144]           [193][193][193][193][193][193][193][193][193][193][193][193][193][193][193][193]"
  66. 413 print"           [211][211][211][211][211][211][211][211][211][211][211][211][211][211][211][211]"
  67. 414 print"[144]              including    "
  68. 415 print "              a count of   "
  69. 416 print"             honor points  "
  70. 417 print"           [218][218][218][218][218][218][218][218][218][218][218][218][218][218][218][218]"
  71. 418 print"[144]           [216][216][216][216][216][216][216][216][216][216][216][216][216][216][216][216]"
  72. 420 :
  73. 421 rem =====sorts & prints hands=====
  74. 422 :
  75. 440 n=13:r1=1:gosub192
  76. 442 hc=0:gosub133
  77. 449 print"[144][147]               hand";r1                     :y=6:x3=0:x=x3
  78. 450 k1=1:forj=1to2:fori=1to7:w$=d$(k1):gosub66:k1=k1+1
  79. 452 x=x+4
  80. 456 next:y=y+4
  81. 458 ifint(j/2)=j/2then460
  82. 459 x=9:next
  83. 460 x=0:next
  84. 462 print"[144]           honor count";hc
  85. 463 if r1=4then476
  86. 464 r1=r1+1:gosub192
  87. 466 hc=0:gosub 133
  88. 468 gosub58
  89. 472 onr1-1goto449,449,474
  90. 474 gosub127:goto449
  91. 476 gosub58
  92. 478 x=14:y=13:w$="        [157][157][157][157][157][157][157][157] again? [157][157][157][157][157][157][157][157] (y/n)  ":gosub66
  93. 480 gosub62
  94. 482 ifa$="n"then60000
  95. 484 goto440
  96. 500 end
  97. 60000 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  98. 60010 if er<>63 then print"[147]":end
  99. 60020 a$="hello connect":q$=chr$(34)
  100. 60030 print"[147]load"q$a$q$",8"
  101. 60040 print"run":poke631,13:poke632,13:poke198,2:end
  102.